unit uDZPageControl;

interface

uses
  SysUtils, Classes, Windows, Graphics, Controls, Forms, Messages, Dialogs,
  RTLConsts, uDZVclBase, uDZGraphics;

type
  TDzCustomPageControl = class;

  TDzTabSheet = class(TWinControl)
  private
    fPageControl: TDzCustomPageControl;
    FMouseOverPicture: TDzMarginBitmap;
    fPicture: TDzMarginBitmap;
    FActivePicture: TDzMarginBitmap;
    procedure SetMouseOverPicture(const Value: TDzMarginBitmap);
    procedure SetPicture(const Value: TDzMarginBitmap);
    procedure SetActivePicture(const Value: TDzMarginBitmap);
    procedure SetPageControl(const Value: TDzCustomPageControl);
    function ReplacePicture(var field: TDzMarginBitmap;
      value: TDzMarginBitmap): Boolean;
    procedure PictureChanged(Sender: TObject; ID: TNotifyID);
    function SelectPicture(Active: Boolean; Flag: TMouseFlag): TDzMarginBitmap;
  protected
    procedure ReadState(Reader: TReader); override;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;

    procedure GetTabDimension(Active: Boolean; Flag: TMouseFlag;
      out TabWidth, TabHeight: Integer);

    procedure PaintTab(cvs: TCanvas; const rect: TRect;
      Active: Boolean; Flag: TMouseFlag);
      
    property PageControl: TDzCustomPageControl read fPageControl write SetPageControl;
  published
    property Left stored False;
    property Height stored False;
    property Top stored False;
    property Visible stored False;
    property Width stored False;
    property Caption;
    property Picture: TDzMarginBitmap read fPicture write SetPicture;
    property MouseOverPicture: TDzMarginBitmap read FMouseOverPicture write SetMouseOverPicture;
    property ActivePicture: TDzMarginBitmap read FActivePicture write SetActivePicture;
  end;

  TPageState = record
    Page: TDzTabSheet;
    TabRect: TRect;
  end;
  PPageState = ^TPageState;

  TDzCustomPageControl = class(TCustomControl)
  private
    fPages: array of TPageState;
    FMaxTabWidth: Integer;
    FTabHeight: Integer;
    FMinTabWidth: Integer;
    fActivePageIndex: Integer;
    fMultiLineTab: Boolean;
    procedure SetMaxTabWidth(const Value: Integer);
    procedure SetMinTabWidth(const Value: Integer);
    procedure SetTabHeight(const Value: Integer);
    procedure SetActivePageIndex(const Value: Integer);
    procedure SetActivePage(const Value: TDzTabSheet);
    procedure CalcTabRegion;
    procedure CheckPageIndex(index: Integer);
    function GetActivePage: TDzTabSheet;
    procedure SetMultiLineTab(const Value: Boolean);
  protected
    procedure WMEraseBkgnd(var msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMSize(var msg: TWMSize); message WM_SIZE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;

    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;

    procedure CreateParams(var params: TCreateParams); override;
    procedure Paint; override;
    procedure Loaded; override;
    procedure WndProc(var Msg: TMessage); override;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    function IndexOf(page: TDzTabSheet): Integer;
    procedure AddPage(page: TDzTabSheet);
    procedure NewPage;
    procedure ExtractPage(page: TDzTabSheet); overload;
    function ExtractPage(index: Integer): TDzTabSheet; overload;
    procedure DeletePage(page: TDzTabSheet); overload;
    procedure DeletePage(index: Integer); overload;
  published
    property Align;
    property MultiLineTab: Boolean read fMultiLineTab write SetMultiLineTab;
    property TabHeight: Integer read FTabHeight write SetTabHeight;
    property MinTabWidth: Integer read FMinTabWidth write SetMinTabWidth;
    property MaxTabWidth: Integer read FMaxTabWidth write SetMaxTabWidth;
    property ActivePageIndex: Integer read FActivePageIndex write SetActivePageIndex;
    property ActivePage: TDzTabSheet read GetActivePage write SetActivePage; 
  end;


implementation

{ TDzCustomPageControl }

procedure TDzCustomPageControl.AddPage(page: TDzTabSheet);
begin
  if page.PageControl <> Self then
  begin
    if Assigned(page.PageControl) then
      page.PageControl.ExtractPage(page);
    SetLength(fPages, Length(fPages) + 1);
    fPages[High(fPages)].Page := page;
    page.fPageControl := Self;
    if fActivePageIndex = Low(fPages) - 1 then
      fActivePageIndex := High(fPages);
    page.Parent := Self;
    page.Align := alNone;
    page.Anchors := [akLeft, akRight, akTop, akBottom];
    CalcTabRegion;
    Invalidate;
  end;
end;

procedure TDzCustomPageControl.CalcTabRegion;
var
  i, wdt, hgt, mhgt, twdt, thgt: Integer;
begin
  if not (csLoading in Self.ComponentState) then
  begin
    if fMultiLineTab then
    begin
    end
    else begin 
      twdt := 0;
      thgt := 0;
      mhgt := 0;
      for i := Low(fPages) to High(fPages) do
      begin
        if fPages[i].Page.Visible then
        begin
          fPages[i].TabRect.Top := thgt;
          fPages[i].TabRect.Left := twdt;
          fPages[i].Page.GetTabDimension(fActivePageIndex = i, [], wdt, hgt);
          if wdt = 0 then wdt := FMinTabWidth
          else begin
            if mhgt < hgt then mhgt := hgt;
          end;
          fPages[i].TabRect.Right := twdt + wdt;
          twdt := twdt + wdt;
        end;
      end;
      if mhgt = 0 then mhgt := FTabHeight;
      for i := Low(fPages) to High(fPages) do
      begin
        fPages[i].TabRect.Bottom := fPages[i].TabRect.Top + mhgt;
        fPages[i].Page.SetBounds(0, mhgt, Self.ClientWidth,
          Self.ClientHeight - mhgt);
      end;
    end;
    if fActivePageIndex >= Low(fPages) then
      fPages[fActivePageIndex].Page.BringToFront;
  end;
end;

procedure TDzCustomPageControl.CheckPageIndex(index: Integer);
begin
  if (index < Low(fPages)) or (index > High(fPages)) then
    raise EListError.CreateFmt(SListIndexError, [index]);
end;

constructor TDzCustomPageControl.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  ControlStyle := [csClickEvents, csFramed];
  Width := 400;
  Height := 200;
  Color := clBtnFace;
  FTabHeight := 35;
  FMaxTabWidth := 200;
  FMinTabWidth := 40;
  fActivePageIndex := -1;
end;

procedure TDzCustomPageControl.DeletePage(page: TDzTabSheet);
var
  index: Integer;
begin
  index := IndexOf(page);
  CheckPageIndex(index);
  DeletePage(index);  
end;

procedure TDzCustomPageControl.CreateParams(var params: TCreateParams);
begin
  inherited;
  with Params do
  begin
    Style := Style and not WS_CLIPCHILDREN;
    Style := Style and not WS_CLIPSIBLINGS;
    ExStyle := ExStyle or WS_EX_TRANSPARENT;
  end;
end;

procedure TDzCustomPageControl.DeletePage(index: Integer);
var
  page: TDzTabSheet;
begin
  page := ExtractPage(index);
  page.Free;
end;

destructor TDzCustomPageControl.Destroy;
var
  i: Integer;
begin
  for i := Low(fPages) to High(fPages) do
  begin
    fPages[i].Page.fPageControl := nil;
    fPages[i].Page.Free;
  end;
  SetLength(fPages, 0);
  fActivePageIndex := Low(fPages) - 1;
  inherited;
end;

procedure TDzCustomPageControl.ExtractPage(page: TDzTabSheet);
var
  index: Integer;
begin
  index := IndexOf(page);
  ExtractPage(index);
end;

function TDzCustomPageControl.ExtractPage(index: Integer): TDzTabSheet;
var
  i: Integer;
begin
  CheckPageIndex(index);
  Result := fPages[index].Page;
  Result.fPageControl := nil;
  for i := index to High(fPages) - 1 do
    fPages[i].Page := fPages[i + 1].Page;
  SetLength(fPages, Length(fPages) - 1);
  if FActivePageIndex > High(fPages) then
    FActivePageIndex := High(fPages);
  CalcTabRegion;
  Invalidate;
end;

function TDzCustomPageControl.GetActivePage: TDzTabSheet;
begin
  if FActivePageIndex >= Low(fPages) then 
    Result := fPages[fActivePageIndex].Page
  else
    Result := nil;
end;

function TDzCustomPageControl.IndexOf(page: TDzTabSheet): Integer;
var
  i: Integer;
begin
  for i := Low(fPages) to High(fPages) do
  begin
    if fPages[i].Page = page then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := Low(fPages) - 1;
end;

procedure TDzCustomPageControl.Loaded;
begin
  inherited;
  CalcTabRegion;
  Invalidate;
end;

procedure TDzCustomPageControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;

end;

procedure TDzCustomPageControl.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
end;

procedure TDzCustomPageControl.NewPage;
var
  page: TDzTabSheet;
begin
  if csDesigning in Self.ComponentState then
  begin
    page := TDzTabSheet.Create(GetParentForm(Self));
    page.Name := GetParentForm(Self).Designer.UniqueName('DzTabSheet');
  end
  else
    page := TDzTabSheet.Create(Self);
  AddPage(page);
end;

procedure TDzCustomPageControl.Paint;
var
  i: Integer;
begin
  inherited;
  for i := Low(fPages) to High(fPages) do
  begin
    fPages[i].Page.PaintTab(Self.Canvas, fPages[i].TabRect,
      fActivePageIndex = i, []);
  end;
end;

procedure TDzCustomPageControl.SetActivePage(const Value: TDzTabSheet);
var
  index: Integer;
begin
  index := IndexOf(Value);
  if index <> Low(fPages) - 1 then
    ActivePageIndex := index;
end;

procedure TDzCustomPageControl.SetActivePageIndex(const Value: Integer);
begin
  if (FActivePageIndex <> Value) and (Value <> Low(fPages) - 1) then
  begin
    if csLoading in Self.ComponentState then
      FActivePageIndex := Value
    else begin
      CheckPageIndex(Value);
      FActivePageIndex := Value;
      CalcTabRegion;
      Invalidate;
    end;
  end;
end;

procedure TDzCustomPageControl.SetMaxTabWidth(const Value: Integer);
begin
  FMaxTabWidth := Value;
end;

procedure TDzCustomPageControl.SetMinTabWidth(const Value: Integer);
begin
  FMinTabWidth := Value;
end;

procedure TDzCustomPageControl.SetMultiLineTab(const Value: Boolean);
begin
  if fMultiLineTab <> Value then
  begin
    fMultiLineTab := Value;
    CalcTabRegion;
    Invalidate;
  end;
end;

procedure TDzCustomPageControl.SetTabHeight(const Value: Integer);
begin
  FTabHeight := Value;
end;

procedure TDzCustomPageControl.WMEraseBkgnd(var msg: TWMEraseBkgnd);
begin
  inherited;
  //msg.Result := 1;
end;

procedure TDzCustomPageControl.WndProc(var Msg: TMessage);
var
  x, y: Integer;
  i: Integer;
begin
  if Msg.Msg = WM_LBUTTONDOWN then
  begin
    x := TWMLButtonDown(Msg).XPos;
    y := TWMLButtonDown(Msg).YPos;
    for i := Low(fPages) to High(fPages) do
    begin
      if PtInRect(fPages[i].TabRect, Point(x, y)) then
      begin
        ActivePageIndex := i;
        Break;
      end;
    end;
  end;
  inherited;
end;

procedure TDzCustomPageControl.WMSize(var msg: TWMSize);
begin
  inherited;
  CalcTabRegion;
  Invalidate;
end;

{ TDzTabSheet }

constructor TDzTabSheet.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  ControlStyle := [csAcceptsControls, csFixedWidth, csFixedHeight];
  Width := 185;
  Height := 41;
  Color := clBtnFace;
end;

destructor TDzTabSheet.Destroy;
begin
  if Assigned(fPageControl) then
  begin
    fPageControl.ExtractPage(Self);
  end;
  SetPicture(nil);
  SetMouseOverPicture(nil);
  SetActivePicture(nil);
  inherited;
end;

procedure TDzTabSheet.GetTabDimension(Active: Boolean; Flag: TMouseFlag;
  out TabWidth, TabHeight: Integer);
var
  pic: TDzMarginBitmap;
begin
  pic := SelectPicture(Active, Flag);
  if Assigned(pic) then
  begin
    TabWidth := pic.Graphic.Width;
    TabHeight := pic.Graphic.Height;
  end
  else begin
    TabWidth := 0;
    TabHeight := 0;
  end;
end;

procedure TDzTabSheet.PaintTab(cvs: TCanvas; const rect: TRect;
  Active: Boolean; Flag: TMouseFlag);
var
  pic: TDzMarginBitmap;
begin
  pic := SelectPicture(Active, Flag);
  if Assigned(pic) and not pic.Graphic.Empty then
  begin
    cvs.Draw(rect.Left, rect.Bottom - pic.Graphic.Height, pic.Graphic);
  end
  else begin
    DrawFrameControl(cvs.Handle, rect, DFC_BUTTON, DFCS_BUTTONPUSH);
  end;
end;

procedure TDzTabSheet.PictureChanged(Sender: TObject; ID: TNotifyID);
begin
  if ID = niDestroy then
  begin
    if Sender = FMouseOverPicture then
      SetMouseOverPicture(nil);

    if Sender = fPicture then
      SetPicture(nil);

    if Sender = FActivePicture then
      SetActivePicture(nil);
  end
  else if ID = niChange then
  begin
    if Assigned(fPageControl) then
    begin
      fPageControl.CalcTabRegion;
      fPageControl.Invalidate;
    end;
  end;
end;

procedure TDzTabSheet.ReadState(Reader: TReader);
begin
  inherited;
  if Reader.Parent is TDzCustomPageControl then
    PageControl := TDzCustomPageControl(Reader.Parent);  
end;

function TDzTabSheet.ReplacePicture(var field: TDzMarginBitmap;
  value: TDzMarginBitmap): Boolean;
begin
  Result := field <> value;
  if Result then
  begin
    if Assigned(field) then
      field.RemoveOnChangeListener(Self.PictureChanged);
    field := Value;
    if Assigned(field) then
      field.AddOnChangeListener(Self.PictureChanged);
  end;
end;

function TDzTabSheet.SelectPicture(Active: Boolean;
  Flag: TMouseFlag): TDzMarginBitmap;
begin
  if Active then Result := FActivePicture
  else if mfIn in Flag then Result := FMouseOverPicture
  else Result := fPicture;
end;

procedure TDzTabSheet.SetActivePicture(const Value: TDzMarginBitmap);
begin
  if ReplacePicture(FActivePicture, Value) and Assigned(fPageControl) then
  begin
    fPageControl.CalcTabRegion;
    fPageControl.Invalidate;
  end;
end;

procedure TDzTabSheet.SetMouseOverPicture(const Value: TDzMarginBitmap);
begin
  if ReplacePicture(FMouseOverPicture, Value) and Assigned(fPageControl) then
  begin
    fPageControl.CalcTabRegion;
    fPageControl.Invalidate;
  end;
end;

procedure TDzTabSheet.SetPageControl(const Value: TDzCustomPageControl);
begin
  Value.AddPage(Self);
end;

procedure TDzTabSheet.SetPicture(const Value: TDzMarginBitmap);
begin
  if ReplacePicture(fPicture, Value) and Assigned(fPageControl) then
  begin
    fPageControl.CalcTabRegion;
    fPageControl.Invalidate;
  end;
end;

end.
